#!/usr/bin/perl -wc

package RFCMail::Util::PackIt::Translator;

use strict;
use RFCMail::Util::PackIt::Data;
use RFCMail::Util::PackIt::Convert;

# data format for new() is [ hash of data types, list of common fields, name of type field, hash of message types ]
# Hash of data type: hash by data type name of [encode method, decode method, size in bytes]
# List of fields: list of [field name, data type name]
# Hash of message types: hash by message type name of [message type number, list of fields, hash of options]
# Hash of options: hash by option name of [option number, type, max count, required pattern]

sub new {
    my ($class, $structure) = @_;
    # some hashes require reverse-index generation
    my $msgdefs = $structure->[3];
    for (keys %$msgdefs) {
	my $tag = $msgdefs->{$_}->[0];
	$msgdefs->{$tag} = $_;
	my $opts = $msgdefs->{$_}->[2];
	for (keys %$opts) {
	    $tag = $opts->{$_}->[0];
	    $opts->{$tag} = $_;
	}
    }
    return (bless $structure, $class);
}


sub decode {
    my ($self, $data, $msg) = @_;
    $msg = {} if not defined($msg);
    # Common elements
    for (@{$self->[1]}) {
	my ($name, $type) = @$_;
	my $op = $self->[0]->{$type}->[1];
	eval { $msg->{$name} = $data->$op };
	die "error decoding '$name': $@"
	    if $@;
    }
    # Message type
    my $m_type_number = $msg->{$self->[2]};
    die "message type '$m_type_number' unknown"
	if not defined($self->[3]->{$m_type_number});
    my $m_type_name = $self->[3]->{$m_type_number};
    $msg->{$self->[2]} = $m_type_name;
    # Type-specific elements
    for (@{$self->[3]->{$m_type_name}->[1]}) {
	my ($name, $type) = @$_;
	my $op = $self->[0]->{$type}->[1];
	eval { $msg->{$name} = $data->$op };
	die "error decoding '$name': $@"
	    if $@;
    }
    # Optional elements
    my $opt = $self->[3]->{$m_type_name}->[2];
    while (not $data->at_eof()) {
	my $onum = $data->RFCMail::Util::PackIt::Convert::get_u8();
	my $odata = RFCMail::Util::PackIt::Data->new($data->RFCMail::Util::PackIt::Convert::get_var8());
	if (defined($opt->{$onum})) {
	    my $oname = $opt->{$onum};
	    my ($num, $type, $max) = @{$opt->{$oname}};
	    my $op = $self->[0]->{$type}->[1];
	    die "internal inconsistency between option name and number"
		if $num != $onum;
	    if ($max == 1) {
		die "singleton option field '$oname' defined more than once"
		    if exists($msg->{$oname});
		eval { $msg->{$oname} = $odata->$op };
		die "error decoding '$oname': $@"
		    if $@;
	    }
	    else {
		$msg->{$oname} = []
		    if not defined($msg->{$oname});
		eval { push @{$msg->{$oname}}, $odata->$op };
		die "error decoding '$oname': $@"
		    if $@;
		die "too many instances of option '$oname'"
		    if defined($max) and scalar(@{$msg->{$oname}}) > $max;
	    }
	    die "option '$oname' size is incorrect"
		if not $odata->at_eof();
	}
    }
    return ($msg);
}


sub encode {
    my ($self, $msg, $data) = @_;
    $data = RFCMail::Util::PackIt::Data->new()
	if not defined($data);
    # Message type (obtain, and convert to number)
    my $m_type_name = $msg->{$self->[2]};
    die "message type '$m_type_name' unknown"
	if not defined($self->[3]->{$m_type_name});
    $msg->{$self->[2]} = $self->[3]->{$m_type_name}->[0];
    # Common fields
    for (@{$self->[1]}) {
	my ($name, $type) = @$_;
	my $op = $self->[0]->{$type}->[0];
	die "missing common field '$name'"
	    if not exists($msg->{$name});
	eval { $data->$op($msg->{$name}) };
	die "error encoding '$name': $@"
	    if $@;
    }
    # Type-specific elements
    for (@{$self->[3]->{$m_type_name}->[1]}) {
	my ($name, $type) = @$_;
	my $op = $self->[0]->{$type}->[0];
	die "missing type-specific field '$name'"
	    if not exists($msg->{$name});
	eval { $data->$op($msg->{$name}) };
	die "error encoding '$name': $@"
	    if $@;
    }
    # Optional elements
    my $opt = $self->[3]->{$m_type_name}->[2];
    for my $oname (keys %$opt) {
	if (exists($msg->{$oname})) {
	    my ($num, $type, $max) = @{$opt->{$oname}};
	    my $op = $self->[0]->{$type}->[0];
	    if ($max == 1) { $msg->{$oname} = [$msg->{$oname}] }
	    die "too many instances of option '$oname'"
		if defined($max) and scalar(@{$msg->{$oname}}) > $max;
	    for (@{$msg->{$oname}}) {
		$data->RFCMail::Util::PackIt::Convert::put_u8($num);
		my $odata = eval { RFCMail::Util::PackIt::Data->new->$op($_)->data() };
		die "error encoding '$oname': $@"
		    if $@;
		$data->RFCMail::Util::PackIt::Convert::put_var8($odata);
	    }
	}
    }
    return ($data);
}

1;
